home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / tsfaqp35.zip / FAQPAS5.TXT < prev    next >
Text File  |  1996-11-12  |  13KB  |  351 lines
  1. From ts@uwasa.fi Tue Nov 12 00:00:00 1996
  2. Subject: FAQPAS5.TXT contents
  3.  
  4.                                Copyright (c) 1993-1996 by Timo Salmi
  5.                                                  All rights reserved
  6.  
  7. FAQPAS5.TXT The fifth set of frequently (and not so frequently)
  8. asked Turbo Pascal questions with Timo's answers. The items are in
  9. no particular order.
  10.  
  11. You are free to quote brief passages from this file provided you
  12. clearly indicate the source with a proper acknowledgment.
  13.  
  14. Comments and corrections are solicited. But if you wish to have
  15. individual Turbo Pascal consultation, please post your questions to
  16. a suitable Usenet newsgroup like news:comp.lang.pascal.borland. It
  17. is much more efficient than asking me by email. I'd like to help,
  18. but I am very pressed for time. I prefer to pick the questions I
  19. answer from the Usenet news. Thus I can answer publicly at one go if
  20. I happen to have an answer. Besides, newsgroups have a number of
  21. readers who might know a better or an alternative answer. Don't be
  22. discouraged, though, if you get a reply like this from me. I am
  23. always glad to hear from fellow Turbo Pascal users.
  24.  
  25. ....................................................................
  26. Prof. Timo Salmi   Co-moderator of news:comp.archives.msdos.announce
  27. Moderating at ftp:// & http://garbo.uwasa.fi archives  193.166.120.5
  28. Department of Accounting and Business Finance  ; University of Vaasa
  29. mailto:ts@uwasa.fi  <URL:http://uwasa.fi/~ts>  ; FIN-65101,  Finland
  30.  
  31. --------------------------------------------------------------------
  32. 101) How do I detect if mouse hardware/driver is installed?
  33. 102) How can I read absolute sectors directly from a floppy?
  34. 103) How can I move a file to another directory in Turbo Pascal?
  35. 104) How can I get/set a disk volume label?
  36. 105) Is there a function to chop off the leading zero from 0.322?
  37. 106) How can I print a text file (and conclude sending a formfeed)?
  38. 107) How can I round 4.1256455 to two decimal places to give 4.13?
  39. 108) How can I list with paths all the files on a drive?
  40. --------------------------------------------------------------------
  41.  
  42. From ts@uwasa.fi Tue Nov 12 00:01:41 1996
  43. Subject: Detecting mouse
  44.  
  45. 101. *****
  46.  Q: How do I detect if mouse hardware/driver is installed?
  47.  
  48.  A: The source code is given below. For more mouse related functions
  49. please see ftp://garbo.uwasa.fi/pc/programming/inter52c.zip for
  50. interrupt $33 functions.
  51.   uses Dos;
  52.   (* Detect if mouse hardware/driver is installed; initializes driver *)
  53.   function MOUSDRFN : boolean;
  54.   var regs : registers;
  55.   begin
  56.     FillChar (regs, SizeOf(regs), 0);  { Just to make sure }
  57.     regs.ax := $0000;                  { Interrupt function number }
  58.     Intr ($33, regs);                  { Call interrupt $33 }
  59.     if regs.ax = $FFFF then
  60.       mousdrfn := true
  61.       else mousdrfn := false;
  62.   end;  (* mousedrfn *)
  63. --------------------------------------------------------------------
  64.  
  65. From ts@uwasa.fi Tue Nov 12 00:01:42 1996
  66. Subject: Reading absolute sectors
  67.  
  68. 102. *****
  69.  Q: How can I read absolute sectors directly from a floppy?
  70.  
  71.  A: Here is the source code for reading directly from a floppy disk.
  72. For directly reading data from hard disk, please study the
  73. information for interrupt $13 function $02 in Ralf Brown's list of
  74. interrupts ftp://garbo.uwasa.fi/pc/programming/inter52a.zip.
  75.   uses Dos;
  76.   type readBufferType = array [1..1024] of byte;
  77.   procedure READFLPY (drive  : char;
  78.                       side   : byte;
  79.                       track  : byte;
  80.                       sector : byte;
  81.                       var rb : readBufferType;
  82.                       var ok : boolean);
  83.   var regs : registers;
  84.        i : byte;
  85.   begin
  86.     ok := false;
  87.     for i := 1 to 3 do begin
  88.       FillChar (regs, SizeOf(regs), 0);  { Just to make sure }
  89.       regs.ah := $02;                    { Function }
  90.       regs.al := 2;                      { Number of sectors to read }
  91.       regs.dl := ord(Upcase(drive))-ord('A');
  92.       if (regs.dl < 0) or (regs.dl > 1) then exit;   { For floppies only }
  93.       regs.dh := side;
  94.       regs.ch := track;
  95.       regs.cl := sector;
  96.       regs.es := Seg(rb);
  97.       regs.bx := Ofs(rb);
  98.       Intr ($13, regs);                  { Call interrupt $13 }
  99.       if regs.flags and FCarry = 0 then begin   { Was it ok? }
  100.         ok := true; exit;
  101.       end; {if}
  102.       { reset and try again a maximum of three times }
  103.       FillChar (regs, SizeOf(regs), 0);  { Just to make sure }
  104.       regs.ah := $00;                    { Function }
  105.       regs.dl := ord(Upcase(drive))-ord('A');
  106.     end; {for i}
  107.   end;  (* readflpy *)
  108. --------------------------------------------------------------------
  109.  
  110. From ts@uwasa.fi Tue Nov 12 00:01:43 1996
  111. Subject: Moving files
  112.  
  113. 103. *****
  114.  Q: How can I move a file to another directory in Turbo Pascal?
  115.  
  116.  A: If the file and the target directory are on the same disk you
  117. can use Turbo Pascal's rename command for the purpose. If they are
  118. on separate disks you'll first have to copy the file as explained in
  119. the item "How can I copy a file in a Turbo Pascal program?" and then
  120. erase the original as explained in the item "Can you tell a beginner
  121. how to delete files with Turbo Pascal?"
  122.   var f : file;
  123.   begin
  124.     Assign (f, 'r:\faq.pas');
  125.     {$I-} Rename (f, 'r:\cmand\faq.pas'); {$I+}
  126.     if IOResult = 0 then
  127.       writeln ('File moved') else writeln ('File not moved');
  128.   end.
  129. --------------------------------------------------------------------
  130.  
  131. From ts@uwasa.fi Tue Nov 12 00:01:44 1996
  132. Subject: Getting/setting volume label
  133.  
  134. 104. *****
  135.  Q: How can I get/set a disk volume label?
  136.  
  137.  A: Getting the volume label can be done in alternative ways. Below
  138. is one of them
  139.   Uses Dos;
  140.   (* Get a disk's volume label *)
  141.   function GETLABFN (device : char) : string;
  142.   var FileInfo : SearchRec;
  143.       fsplit_dir  : DirStr;
  144.       fsplit_name : NameStr;
  145.       fsplit_ext  : ExtStr;
  146.       stash       : byte;
  147.   begin
  148.     getlabfn := '';
  149.     device := UpCase (device);
  150.     if (device < 'A') or (device > 'Z') then exit;
  151.     {}
  152.     stash := fileMode;
  153.     FileMode := $40;
  154.     FindFirst (device + ':\*.*', AnyFile, FileInfo);
  155.     while DosError = 0 do
  156.       begin
  157.         if ((FileInfo.Attr and VolumeId) > 0) then
  158.           begin
  159.             FSplit (FExpand(FileInfo.Name),
  160.                     fsplit_dir, fsplit_name, fsplit_ext);
  161.             Delete (fsplit_ext, 1, 1);
  162.             getlabfn := fsplit_name + fsplit_ext;
  163.             FileMode := stash;
  164.             exit;
  165.           end;
  166.         FindNext (FileInfo);
  167.       end; {while}
  168.     FileMode := stash;
  169.   end; (* getlabfn *)
  170.  
  171. As for setting a disk volume label with Turbo Pascal that is a much
  172. more complicated task. You'll need to manipulate the File Control
  173. Block (FCB). This alternative is not taken further in here. If you
  174. need the procedure it is available without the source code as
  175.   "SETLABEL Set a disk's volume label"
  176.   in TSUNTL.TPU in ftp://garbo.uwasa.fi/pc/ts/tspa3570.zip.
  177. An alternative is shelling to Dos to call its own LABEL.EXE program
  178. as follows
  179.   {$M 2048, 0, 0}   (* <-- Important. Adjust if out of memory. *)
  180.   Uses Dos;
  181.   begin
  182.     SwapVectors;
  183.     Exec (GetEnv('comspec'), '/c label A:');  (* Execution *)
  184.     SwapVectors;
  185.   end.
  186. --------------------------------------------------------------------
  187.  
  188. From ts@uwasa.fi Tue Nov 12 00:01:45 1996
  189. Subject: Omitting leading zero
  190.  
  191. 105. *****
  192.  Q: Is there a function to chop off the leading zero from 0.322?
  193.  
  194.  A: If you wish to output a real without the leading zero you can
  195. use the following function
  196.   function CHOPFN (x : real; dd : byte) : string;
  197.   var s : string;
  198.   begin
  199.     Str (x:0:dd, s);
  200.     if x >= 0 then
  201.       chopfn := Copy (s,2,255)
  202.     else
  203.       chopfn := '-' + Copy (s,3,255);
  204.   end;  (* chopfn *)
  205. There are other options. What is below is more cumbersome than
  206. CHOPFN, but it demonstrates the usage of the Move command rather
  207. nicely.
  208.   function CHOP2FN (x : real; dd : byte) : string;
  209.   var s : string;
  210.   begin
  211.     Str (x:0:dd, s);
  212.     if x >= 0 then begin
  213.       Move (s[2],s[1],Length(s)-1);
  214.       Dec(s[0]);
  215.       chop2fn := s;
  216.       end
  217.     else begin
  218.       Move (s[3],s[1],Length(s)-2);
  219.       Dec(s[0],2);
  220.       chop2fn := '-' + s;
  221.     end;
  222.   end;  (* chop2fn *)
  223. --------------------------------------------------------------------
  224.  
  225. From ts@uwasa.fi Tue Nov 12 00:01:46 1996
  226. Subject: Printing a file and a formfeed
  227.  
  228. 106. *****
  229.  Q: How can I print a text file (and conclude sending a formfeed)?
  230.  
  231.  A: We can turn this beginner's question into some instructive
  232. source code. Study carefully the many details included. For printer
  233. handling you might also wish to see in my FAQ the separate item
  234. number 15 "How can I test that the printer is ready?"
  235.   Uses Printer;             { Associates lst with the LPT1 device }
  236.   const formfeed = #12;     { The formfeed character }
  237.   var s : string;           { A string for a single line }
  238.       filename : string;    { A variable for the file name }
  239.       f : text;             { Text-file variable }
  240.       fmsave : byte;        { For storing the original filemode }
  241.   begin
  242.     if ParamCount > 0 then  { If there are parameters on the command line }
  243.       filename := ParamStr(1)                     { get the first of them }
  244.     else begin
  245.       writeln ('Usage: ', ParamStr(0), ' [Filename]');
  246.       halt(1);              { Sets errorlevel to 1 for batches }
  247.     end;
  248.     fmSave := FileMode;     { Save the current filemode }
  249.     FileMode := $40;        { To handle also read-only and network files }
  250.     Assign (f, filename);   { Associate file variable with file name }
  251.     {$I-}                   { Input/Output-Checking temporarily off }
  252.     Reset (f);              { Open the file }
  253.     {$I+}
  254.     if IOResult <> 0 then begin    { Check failure of opening the file }
  255.       writeln ('Error opening ', filename);
  256.       FileMode := fmSave;   { Restore original filemode }
  257.       halt(2);              { Sets errorlevel to 2 for batches }
  258.     end; {if}
  259.     while not eof(f) do begin
  260.       readln (f, s);        { Read a line, maximum length 255 characters }
  261.       writeln (lst, s);     { Write the line to the printer }
  262.     end; {while}
  263.     Close (f);              { Close the file }
  264.     FileMode := fmSave;     { Restore the original filemode }
  265.     write (lst, formfeed);  { Eject the page from the printer }
  266.   end.
  267. --------------------------------------------------------------------
  268.  
  269. From ts@uwasa.fi Tue Nov 12 00:01:47 1996
  270. Subject: Rounding a value
  271.  
  272. 107. *****
  273.  Q: How can I round 4.1256455 to two decimal places to give 4.13?
  274.  
  275.  A: Here is the source code. Note the two alternatives. The trivial
  276. one of just formulating the output, and the more complicated of
  277. actually rounding the value of a variable.
  278.   var x, y : real;
  279.   {}
  280.   (* Sign function, needed to round negative values correctly *)
  281.   function SignFn (a : real) : real;
  282.   begin
  283.     if a > 0.0 then signfn := 1.0
  284.       else if a < 0.0 then signfn := -1.0
  285.         else signfn := 0.0;
  286.   end; (* sgnfn *)
  287.   {}
  288.   (* Round a real variable to d decimal places *)
  289.   function RoundRealFn (x : real; d : byte) : real;
  290.   var a : real;
  291.       i : byte;
  292.   begin
  293.     a := 1.0;
  294.     for i := 1 to d do a := a*10.0;
  295.     RoundRealFn := Int (a*x + SignFn(x)*0.5) / a;
  296.   end;  (* RoundRealFn *)
  297.   {}
  298.   (* Test *)
  299.   begin
  300.     x := 4.1256455;
  301.     {}
  302.     { ... The case of actually rounding a variable ...}
  303.     y := RoundRealFn (x, 2);
  304.     writeln (x, ' ', y);
  305.     {}
  306.     {... The more common case case of rounding the output only ...}
  307.     writeln (x:0:2);
  308.   end.
  309. --------------------------------------------------------------------
  310.  
  311. From ts@uwasa.fi Tue Nov 12 00:01:48 1996
  312. Subject: Recursing directories
  313.  
  314. 108. *****
  315.  Q: How can I list with paths all the files on a drive?
  316.  
  317.  A: Here is the example source code
  318.   {$M 16384,0,0}
  319.   Uses Dos;
  320.   {... the top directory ...}
  321.   procedure FindFiles (Path, FileSpec : string);
  322.   var FileInfo : SearchRec;
  323.   begin
  324.     FindFirst (Path + FileSpec, AnyFile, FileInfo);
  325.     while DosError = 0 do begin
  326.       if ((FileInfo.Attr and Directory) = 0) and
  327.          ((FileInfo.Attr and VolumeId) = 0) then begin
  328.         writeln (Path+FileInfo.Name);
  329.       end; {if}
  330.       FindNext (FileInfo);
  331.     end; {while}
  332.     {}
  333.     {... subdirectories ...}
  334.     FindFirst (Path + '*.*', Directory, FileInfo);
  335.     while DosError = 0 do
  336.       begin
  337.         if ((FileInfo.Attr and Directory) > 0) and
  338.             (FileInfo.Name <> '.') and
  339.             (FileInfo.Name <> '..') then
  340.               FindFiles (Path + FileInfo.Name + '\', FileSpec);
  341.         FindNext (FileInfo);
  342.       end; {while}
  343.   end;  (* findfiles *)
  344.   {}
  345.   begin
  346.     FindFiles ('C:\', '*.*');  { Note the trailing \ }
  347.   end.
  348. For starting below the root, use e.g. FindFiles ('C:\DOS\', '*.*');
  349. --------------------------------------------------------------------
  350.  
  351.